home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Arraysort.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  4.7 KB  |  140 lines  |  [TEXT/R*ch]
  1. (* Arraysort.sml -- adapted for Moscow ML from SML/NJ library v. 0.2
  2.  *
  3.  * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  
  4.  * See file mosml/copyrght/copyrght.att for details.
  5.  *
  6.  * Structure for in-place sorting of arrays.
  7.  * Uses an engineered version of quicksort due to 
  8.  * Bentley and McIlroy.
  9.  *
  10.  *)
  11.  
  12. local
  13.     open Array
  14.  
  15.     prim_type 'a array_; (* i.e. the runtime system's idea of an array *)
  16.     prim_val length_ : 'a array_ -> int                = 1 "vect_length";
  17.     prim_val sub_    : 'a array_ -> int -> 'a          = 2 "get_vect_item";
  18.     prim_val update_ : 'a array_ -> int -> 'a -> unit  = 3 "set_vect_item";
  19.  
  20.     prim_val magic   : 'a -> 'b                        = 1 "identity";
  21.     fun from_array (a : 'a array) = !(magic a) : 'a array_
  22.  
  23. fun min (x, y) = if x < y then x else y : int;
  24.  
  25. fun sortRange (array, start, n, cmp) = let
  26.       fun swap i j = 
  27.       let val tmp = sub_ array i
  28.       in update_ array i (sub_ array j); update_ array j tmp end
  29.       fun vecswap i j 0 = ()
  30.         | vecswap i j n = (swap i j; vecswap (i+1) (j+1) (n-1))
  31.       fun insertSort (start, n) = let
  32.             val limit = start+n
  33.             fun outer i =
  34.                   if i >= limit then ()
  35.                   else let
  36.                     fun inner j =
  37.                           if j = start then outer(i+1)
  38.                           else let
  39.                             val j' = j - 1
  40.                             in
  41.                               if cmp(sub_ array j', sub_ array j) = GREATER
  42.                                 then (swap j j'; inner j')
  43.                                 else outer(i+1)
  44.                             end
  45.                     in inner i end
  46.             in
  47.               outer (start+1)
  48.             end
  49.  
  50.       fun med3 a b c =
  51.             case (cmp(sub_ array a, sub_ array b),
  52.           cmp(sub_ array b, sub_ array c)) of
  53.               (LESS,LESS) => b
  54.             | (LESS, _  ) =>
  55.           (case cmp(sub_ array a, sub_ array c) of LESS => c | _ => a)
  56.             | (_,GREATER) => b
  57.             |  _          => 
  58.           (case cmp(sub_ array a, sub_ array c) of LESS => a | _ => c)
  59.  
  60.       fun getPivot (a,n) = 
  61.             if n <= 7 then a + n div 2
  62.             else let
  63.               val p1 = a
  64.               val pm = a + n div 2
  65.               val pn = a + n - 1
  66.               in
  67.                 if n <= 40 then med3 p1 pm pn
  68.                 else let
  69.                   val d = n div 8
  70.                   val p1 = med3 p1 (p1+d) (p1+2*d)
  71.                   val pm = med3 (pm-d) pm (pm+d)
  72.                   val pn = med3 (pn-2*d) (pn-d) pn
  73.                   in
  74.                     med3 p1 pm pn
  75.                   end
  76.               end
  77.       
  78.       fun quickSort (arg as (a, n)) = let
  79.             fun bottom limit = let
  80.                   fun loop pa pb =
  81.                         if pb > limit then (pa, pb)
  82.                         else case cmp(sub_ array pb, sub_ array a) of
  83.                           GREATER => (pa, pb)
  84.                         | LESS => loop pa (pb+1)
  85.                         | _ => (swap pa pb; loop (pa+1) (pb+1))
  86.                   in loop end
  87.   
  88.             fun top limit = let
  89.                   fun loop pc pd =
  90.                         if limit > pc then (pc, pd)
  91.                         else case cmp(sub_ array pc, sub_ array a) of
  92.                           LESS => (pc, pd)
  93.                         | GREATER => loop (pc-1) pd
  94.                         | _ => (swap pc pd; loop (pc-1) (pd-1))
  95.                   in loop end
  96.  
  97.             fun split pa pb pc pd = 
  98.         let val (pa,pb) = bottom pc pa pb
  99.             val (pc,pd) = top pb pc pd
  100.         in
  101.                     if pb > pc then (pa,pb,pc,pd)
  102.                     else (swap pb pc; split pa (pb+1) (pc-1) pd)
  103.         end
  104.  
  105.             val pm = getPivot arg
  106.             val _ = swap a pm
  107.             val pa = a + 1
  108.             val pc = a + (n-1)
  109.             val (pa,pb,pc,pd) = split pa pa pc pc
  110.             val pn = a + n
  111.             val r = min(pa - a, pb - pa)
  112.             val _ = vecswap a (pb-r) r
  113.             val r = min(pd - pc, pn - pd - 1)
  114.             val _ = vecswap pb (pn-r) r
  115.             val n' = pb - pa
  116.             val _ = if n' > 1 then sort(a,n') else ()
  117.             val n' = pd - pc
  118.             val _ = if n' > 1 then sort(pn-n',n') else ()
  119.             in () end
  120.  
  121.       and sort (arg as (_, n)) = if n < 7 then insertSort arg 
  122.                                  else quickSort arg
  123.       in sort (start,n) end
  124. in
  125.  
  126. fun sort cmp (arr : 'a array) = 
  127.     sortRange(from_array arr, 0, length arr, cmp)
  128.  
  129. fun sorted cmp (arr : 'a array) = 
  130.     let val len = length arr
  131.     val array = from_array arr
  132.     fun s v1 v2 i = 
  133.         (* s[0..i-2] is sorted & v1 = s[i-2] & v2 = s[i-1] *)
  134.         cmp(v1, v2) <> GREATER
  135.         andalso (i >= len orelse s v2 (sub_ array i) (i+1))
  136.     in
  137.         len = 0 orelse len = 1 orelse s (sub_ array 0) (sub_ array 1) 2
  138.     end
  139. end;
  140.